module Language.ASTExpr.ParserAST where

import Language.ASTExpr.Syntax

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Token
import Text.ParserCombinators.Parsec.Pos

--fromString :: String -> Either String Expr
--fromString s = either (Left . show) (Right) $ parse exprParser "user_input" s


-- | parses one Expression 
exprParser :: Parser Expr
exprParser = do
  { expr <- try exprConstParser
        <|> try exprAddParser
        <|> try exprMulParser
        <|> try exprEVarParser
        <|> exprLetParser
--  ; many newline
  ; return expr
  }

exprEVarParser :: Parser Expr
exprEVarParser = do
  { spaces
  ; many (char '(')
  ; spaces
  ; srcFrom <- getPosition
  ; string "EVar"
  ; var <- varParser
  ; srcTo <- getPosition
  ; spaces
  ; many (char ')')
  ; return (EVar (SrcSpan srcFrom srcTo) var)
  }

exprLetParser :: Parser Expr
exprLetParser = do
  { spaces
  ; many (char '(')
  ; spaces
  ; srcFrom <- getPosition
  ; string "Let"
  ; letDecl <- declParser
  ; inExpr <- exprParser
  ; srcTo <- getPosition
  ; spaces
  ; many (char ')')
  ; return (Let (SrcSpan srcFrom srcTo) letDecl inExpr)
  }

exprAddParser :: Parser Expr
exprAddParser = do
  { spaces
  ; many (char '(')
  ; spaces
  ; srcFrom <- getPosition
  ; string "Add"
  ; leftExpr <- exprParser
  ; rightExpr <- exprParser
  ; srcTo <- getPosition
  ; spaces
  ; many (char ')')
  ; return (Add (SrcSpan srcFrom srcTo) leftExpr rightExpr)
  }

exprMulParser :: Parser Expr
exprMulParser = do
  { spaces
  ; many (char '(')
  ; spaces
  ; srcFrom <- getPosition
  ; string "Mul"
  ; leftExpr <- exprParser
  ; rightExpr <- exprParser
  ; srcTo <- getPosition
  ; spaces
  ; many (char ')')
  ; return (Mul (SrcSpan srcFrom srcTo) leftExpr rightExpr)
  }

exprConstParser :: Parser Expr
exprConstParser = do
  { spaces
  ; many (char '(')
  ; spaces
  ; srcFrom <- getPosition
  ; string "Const"
  ; spaces
  ; constInt <- intParser
  ; srcTo <- getPosition
  ; spaces
  ; many (char ')')
  ; return (Const (SrcSpan srcFrom srcTo) constInt)
  }

varParser :: Parser Char
varParser = do
  { spaces
  ; var <- letter
  ; return var
  }

declVarParser :: Parser Decl
declVarParser = do
  { many (char '(')
  ; spaces
  ; srcFrom <- getPosition
  ; varName <- varParser
  ; spaces
  ; string ":="
  ; spaces
  ; decl <- exprParser
  ; srcTo <- getPosition
  ; spaces
  ; many (char ')')
  ; return ((:=) (SrcSpan srcFrom srcTo) varName decl)
  }

declSeqParser :: Parser Decl
declSeqParser = do
  { many (char '(')
  ; spaces
  ; srcFrom <- getPosition
  ; string "Seq"
  ; firstDecl <- declParser
  ; spaces
  ; secondDecl <- declParser
  ; srcTo <- getPosition
  ; spaces
  ; many (char ')')
  ; return (Seq (SrcSpan srcFrom srcTo) firstDecl secondDecl)
  }

declParser :: Parser Decl
declParser = do
  { decl <- try declSeqParser
         <|> declVarParser
  ; return decl
  }

natParser :: Parser Int
natParser = do
  { number <- many digit
  ; return (read number::Int)
  }

negIntParser :: Parser Int
negIntParser = do
  { many (char '(')
  ; spaces
  ; char '-'
  ; number <- natParser
  ; spaces
  ; many (char ')')
  ; return (0-number)
  }

intParser :: Parser Int
intParser = do
   { number <- try negIntParser
           <|> natParser
   ; return number
   }

-- | skips any of the following whitespace characters ' ' '\v' '\f' '\t' '\r' but not '\n'
space' :: Parser ()
space' = do
  { try (char ' ')
    <|> try (char '\v')
    <|> try (char '\f')
    <|> try (char '\t')
    <|> (char '\r')
  ; return ()
  }

-- | skips zero or more whitespace characters excluding '\n'
spaces' = many space'
